home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 4
/
Apprentice-Release4.iso
/
Languages
/
MacQForth 1.0
/
code
/
intmath.4th
< prev
next >
Wrap
Text File
|
1995-03-29
|
3KB
|
76 lines
( Integer math routines for 16-bit MacQForth )
( RTK - 03.15.95 )
( -------------------------------------------------------------------------- )
( Integer arithmetic scaling, uses a 32-bit multiply )
: */ ( a b c -- a*b/c ) 65392 execute ; ( $FF70 )
( All arithmetic scaled by 10000 )
: pi ( -- pi*10000 ) 31415 ;
( Basic trig*10000 )
( These routines from Pocket Forth 6.3 by Chris Heilman, INTEGERTRIG file )
create sinTable ( a table of sin*10000, angles from 0 to 90 degrees )
00000 ,
00175 , 00349 , 00524 , 00698 , 00872 , 01045 , 01219 , 01392 ,
01571 , 01736 , 01908 , 02079 , 02250 , 02419 , 02588 , 02756 ,
02924 , 03090 , 03256 , 03420 , 03584 , 03746 , 03907 , 04067 ,
04226 , 04384 , 04540 , 04695 , 04848 , 05000 , 05150 , 05299 ,
05446 , 05592 , 05736 , 05878 , 06018 , 06157 , 06293 , 06428 ,
06561 , 06691 , 06820 , 06947 , 07071 , 07193 , 07314 , 07431 ,
07547 , 07660 , 07771 , 07880 , 07986 , 08090 , 08192 , 08290 ,
08387 , 08480 , 08572 , 08660 , 08746 , 08829 , 08910 , 08988 ,
09063 , 09135 , 09205 , 09272 , 09336 , 09397 , 09455 , 09511 ,
09563 , 09613 , 09659 , 09703 , 09744 , 09781 , 09816 , 09848 ,
09877 , 09903 , 09925 , 09945 , 09962 , 09976 , 09986 , 09994 ,
09998 , 10000 ,
: ?negate ( make n positive ) if negate else then ;
: fixangle ( map angle to -180 to 180 range )
dup abs begin dup 180 > while 360 - repeat
swap 0< ?negate ;
: sin ( degrees -- sin*10000 ) ( -180 <= angle <= 180 )
fixangle dup 0< >r abs dup 90 > if 180 swap - else then
2* sinTable + @ r> ?negate ;
: cos ( degrees -- cos*10000 )
dup 0< if 90 + sin else 90 - sin negate then ;
: arcsin ( sine*10000 -- degrees )
dup 0< >r abs ( save sign )
91 0 do ( check all angles )
dup i 2* sinTable + @ > 0= if ( if sin>table value )
drop i leave else then loop 1-
r> ?negate ; ( restore sign )
( additions by RTK )
: tan ( degrees -- tan*10000 ) 10000 swap dup sin swap cos */ ;
( **2, **3, and ** )
variable _x
: **2 dup * ; ( square )
: **3 dup dup * * ; ( cube )
: ** ( x y -- ) ( raise x to the y power )
_y ! _x ! _y @ 0= if 1 else 1 _y @ 0 do _x @ * loop then ;
: .frac ( n d -- ) swap . 8 emit 47 emit . ; ( print a fraction n/d )
: 2hex ( n -- ) ( print as a hex number )
areg ! 64986 execute ;
: .hex ( n d -- ) ( print n as a d digit hex number, d is either 2 or 4 )
swap _x ! 2 = if _x c@ 2hex else _x 1+ c@ 2hex _x c@ 2hex then ;
: 4hex 4 .hex ;